Syntax10.Scn.Fnt
ParcElems
Alloc
Syntax24b.Scn.Fnt
StampElems
Alloc
19 Jun 96
Syntax10b.Scn.Fnt
Syntax10i.Scn.Fnt
Syntax20b.Scn.Fnt
Syntax16b.Scn.Fnt
(* AMIGA *)
MODULE Pictures; (* cn, RD, OJ 
IMPORT
	SYSTEM,Amiga,Files,E:=AmigaExec,G:=AmigaGraphics,I:=AmigaIntuition,Kernel,L:=AmigaLayers, O:=Console;
CONST
	black*=0; white*=15;
	replace*=0; (* The new graphical object completely replaces whatever was before in the destination area. *)
	paint*=1; (* The new graphical object is added to whatever was before in the dertination area. *)
	invert*=2; (* The new graphical object inverts whatever was before in the dertination area. The color specifies, which planes are affected (inverted) and which aren't *)
	PictFileId*=  - 4093;
	BitMapPtr=POINTER TO G.BitMap;
	LayerPtr=POINTER TO G.Layer;
	RastPortPtr=POINTER TO G.RastPort;
	WindowPtr=POINTER TO I.Window;
	ScreenPtr=POINTER TO I.Screen;
	ColMem=ARRAY 256 OF RECORD r, g, b: CHAR END;
	Pattern*=LONGINT;
	Picture*=POINTER TO PictureDesc;
	Notifier*=PROCEDURE (P: Picture; X, Y, W, H : INTEGER);
	PictureDesc*=RECORD
		width*,height*,depth*:INTEGER;
		notify*:Notifier;
		bitMap:G.BitMap; (* Used only in CreateLayer, FreeLayer; V<39*)
		bitMapPtr:G.BitMapPtr; (* Used only in CreateLayer, FreeLayer; V>=39*)
		layer:G.LayerPtr;
		layerInfo: G.LayerInfoPtr; (* Used only in CreateLayer, FreeLayer *)
		rp*: G.RastPortPtr;
		pal: ColMem;
		oldCol:INTEGER;
		oldMode:INTEGER
	END ;
	Frame*=POINTER TO FrameDesc;
	FrameMsg*=RECORD END;
	Handler*=PROCEDURE (f: Frame; VAR msg: FrameMsg);
	FrameDesc*=RECORD
		dsc*, next*: Frame;
		X*, Y*, W*, H*: INTEGER;
		handle*: Handler
	END;
	PatternNode=POINTER TO RECORD
		p: Amiga.PatternInfoPtr;
		next: PatternNode
	END;
	dots*: Pattern;
	ToPrint*: Picture;
	rev: ARRAY 16 OF INTEGER;
	defaultPicture:Picture;
	nofCols, depthMask:INTEGER; (* depthMask:=nofCols-1 *)
	patternRoot:PatternNode;
	DispColBuffer: ColMem;
	DrMode: ARRAY 3 OF SHORTINT;	(* conversion table, used in SetDrawMode *)		(*<<OJ*)
	MinTerm: ARRAY 3 OF CHAR;	(* conversion table, used in CopyBlock *)
PROCEDURE SetDisplayColor*(col, red, green, blue: INTEGER); (*col < 0: overlay color not supported on the Amiga*)
	Set the RGB values for a screen color.
	scr:ScreenPtr;
	win: WindowPtr;
BEGIN
	IF Amiga.ModifyColors & (col<nofCols) & (col>=0) THEN
		win := SYSTEM.VAL(WindowPtr, Amiga.window);
		scr := SYSTEM.VAL(ScreenPtr, win.wScreen);
		G.SetRGB32(
			SYSTEM.VAL(G.ViewPortPtr,SYSTEM.ADR(scr.viewPort)),col+Amiga.ColorOffset,
			SYSTEM.LSH(LONG(red),24),SYSTEM.LSH(LONG(green),24),SYSTEM.LSH(LONG(blue),24)
END SetDisplayColor;
PROCEDURE GetDisplayColor*(col: INTEGER; VAR red, green, blue: INTEGER);
	Return the RGB values for a screen color.
	rgbTable:RECORD r,g,b:LONGINT END;
	scr:ScreenPtr;
	win: WindowPtr;
BEGIN
	win := SYSTEM.VAL(WindowPtr, Amiga.window);
	scr:=SYSTEM.VAL(ScreenPtr, win.wScreen);
	G.GetRGB32(scr.viewPort.colorMap,col MOD nofCols,1,rgbTable);
	red     := SHORT( SYSTEM.LSH(rgbTable.r,-24));
	green := SHORT( SYSTEM.LSH(rgbTable.g,-24));
	blue   := SHORT( SYSTEM.LSH(rgbTable.b,-24))
END GetDisplayColor;
PROCEDURE ColorsToScreen(m: ColMem);
	Copy colors from ColMem to screen
	VAR i: INTEGER;
BEGIN
	FOR i:=0 TO nofCols-1 DO
		SetDisplayColor(i, ORD(m[i].r), ORD(m[i].g), ORD(m[i].b))
END ColorsToScreen;
PROCEDURE GetScreenColors(VAR m: ColMem);
	Copy screen colors to ColMem
	VAR i, r, g, b: INTEGER;
BEGIN
	FOR i:=0 TO nofCols-1 DO
		GetDisplayColor(i, r, g, b);
		m[i].r:=CHR(r); m[i].g:=CHR(g); m[i].b:=CHR(b)
END GetScreenColors;
PROCEDURE UseOberonColors*(p: Picture);
	Store current screen colors to DispColBuffer and copy colors of Picture p to screen
BEGIN
	GetScreenColors(DispColBuffer);
	ColorsToScreen(p.pal)
END UseOberonColors;
PROCEDURE UseBufferedColors*;
	Copy colors from DispColBuffer to screen
BEGIN
	ColorsToScreen(DispColBuffer)
END UseBufferedColors;
PROCEDURE InitLayer(pic:Picture);
	Precondition: pic has already initialized depth, width and height fields.
	Creates bitmap and layer.
		l: LayerPtr;
		rp: RastPortPtr;
BEGIN
	rp:=SYSTEM.VAL(RastPortPtr, defaultPicture.rp);
	pic.bitMapPtr:=G.AllocBitMap(pic.width, pic.height, Amiga.Depth, {}, rp.bitMap);
	Amiga.Assert(pic.bitMapPtr#0,"Can't allocate BitMap");
	pic.layerInfo:=L.NewLayerInfo();
	Amiga.Assert(pic.layerInfo#0,"No layer info");
	pic.layer:=L.CreateUpfrontLayer(
		pic.layerInfo,pic.bitMapPtr,0,0,pic.width-1,pic.height-1,{G.layerSimple,G.layerBackdrop},0
	IF pic.layer=0 THEN HALT(70) END;
	l:=SYSTEM.VAL(LayerPtr,pic.layer);
	pic.rp:=l.rp
END InitLayer;
PROCEDURE FreeLayer(pic:Picture);
	Free layer and bitmap.
BEGIN
	IF pic.layer#0 THEN
		ASSERT(L.DeleteLayer(pic.layer));
		G.WaitBlit();
		pic.layer:=0
	END;
	IF pic.layerInfo#0 THEN L.DisposeLayerInfo(pic.layerInfo); pic.layerInfo:=0 END;
	G.FreeBitMap(pic.bitMapPtr);
	pic.oldCol:=-1;
	pic.oldMode:=-1;
	pic.depth:=0;
	pic.width:=0;
	pic.height:=0
END FreeLayer;
PROCEDURE WindowToPicture*(window:I.WindowPtr; VAR pic:Picture);
	Using this procedure you can create a picture which represents a windows
	contents. This procedure is only intended for use by Display.
	NOTE:
		never reuse this picture in a Pictures.Create call!
	bm:BitMapPtr;
	i:INTEGER;
	rp:RastPortPtr;
	w:WindowPtr;
BEGIN
	w:=SYSTEM.VAL(WindowPtr,window);
	NEW(pic);
	pic.width:=w.width-w.borderLeft-w.borderRight;
	pic.height:=w.height-w.borderTop-w.borderBottom;
	pic.rp:=w.rPort;
	rp:=SYSTEM.VAL(RastPortPtr,w.rPort);
	bm:=SYSTEM.VAL(BitMapPtr,rp.bitMap);
	pic.depth:=bm.depth;
	pic.notify:=NIL;
	FOR i:=0 TO pic.depth-1 DO
		pic.bitMap.planes[i]:=0; (* Used only in CreateLayer, FreeLayer *)
	END;
	pic.layer:=w.wLayer;
	pic.layerInfo:=0; (* Used only in CreateLayer, FreeLayer *)
	pic.oldCol:=-1;
	pic.oldMode:=-1;
	defaultPicture:=pic; (* Remember Oberon screen for DisplayBlock. I hate Pictures/Display! cn *)
END WindowToPicture;
PROCEDURE Finalize(obj: SYSTEM.PTR);
BEGIN
	FreeLayer(SYSTEM.VAL(Picture,obj))
END Finalize;
PROCEDURE Address*(P: Picture): LONGINT;
	Not supported at the Amiga, returns 0
	This PROCEDURE has a side effect. It stores the Picture in ToPrint.
	It is used for Printing Pictures.
BEGIN
	ToPrint:=P;
	RETURN 0
END Address;
PROCEDURE SetDrawMode(pic:Picture; col, mode: INTEGER); (* Faster and Shorter << OJ *)
	Ckeck old DrawModes (Mode, Color) and set new, if changed
	Every PROCEDURE drawing to a Picture has to call this
	WriteMsk has to be changed if mode changes to invert or (in mode invert) the color changes
BEGIN
	IF pic.oldMode # mode THEN
		pic.oldMode := mode;  G.SetDrMd(pic.rp, DrMode[mode]);
		pic.oldCol := col;
		col:=col MOD nofCols;
		IF mode=invert THEN
			G.SetWriteMask(pic.rp, col)
		ELSE
			G.SetWriteMask(pic.rp,depthMask);
			G.SetAPen(pic.rp, col+Amiga.ColorOffset)
		END
	ELSIF pic.oldCol # col THEN
		pic.oldCol := col;
		col:=col MOD nofCols;
		IF mode=invert THEN
			G.SetWriteMask(pic.rp, col)
		ELSE
			G.SetAPen(pic.rp, col+Amiga.ColorOffset)
		END
END SetDrawMode;
PROCEDURE CopyBlock*(sP, dP: Picture; SX, SY, W, H, DX, DY, mode: INTEGER);
	Copy a rectangular area within the display to another place. This procedure assumes, that any single
	area does not cross the boundary between primary and secondary screen.
BEGIN
	IF (W <= 0) OR (H <= 0) THEN RETURN END;
	SetDrawMode(dP, dP.oldCol, mode); (* only to set mask *)
	G.ClipBlit(sP.rp, SX, sP.height-SY(*-1*)-H,
					dP.rp, DX, dP.height-DY(*-1*)-H, W, H, MinTerm[mode])		(*<<OJ*)
END CopyBlock;
PROCEDURE CopyBlockC*(sP, dP:Picture; f: Frame; SX, SY, W, H, DX, DY, mode: INTEGER);
	As CopyBlock, but the destination area is clipped against the Frame boundary.
	VAR dx, dy: INTEGER;
BEGIN
	IF (W <= 0) OR (H <= 0) THEN RETURN END;
	dx := f.X-DX;
	IF dx > 0 THEN INC(SX, dx); DX := f.X; DEC(W, dx) END;
	dx := DX+W-(f.X+f.W);
	IF dx > 0 THEN DEC(W, dx) END;
	dy := f.Y-DY;
	IF dy > 0 THEN INC(SY, dy); DY := f.Y; DEC(H, dy) END;
	dy := DY+H-(f.Y+f.H);
	IF dy > 0 THEN DEC(H, dy) END;
	IF (W > 0) & (H > 0) THEN CopyBlock(sP, dP, SX, SY, W, H, DX, DY, mode) END
END CopyBlockC;
PROCEDURE CopyPattern*(pic:Picture; col: INTEGER; pat: Pattern; X, Y, mode: INTEGER);
	Copy a pattern to the specified location.
	p: Amiga.PatternInfoPtr;
	wordStart:LONGINT;
	bitOffset:INTEGER;
	w, h:INTEGER;
BEGIN
	p := SYSTEM.VAL( Amiga.PatternInfoPtr, pat); w := p.w; h := p.h;
	IF (w > 0) & (h > 0) THEN
		SetDrawMode(pic, col, mode);
		wordStart:=p.data+p.offset DIV 8;
		bitOffset:=SHORT(p.offset MOD 8);
		IF ODD(wordStart) THEN
			DEC(wordStart);
			INC(bitOffset,8)
		END;
		G.BltTemplate(wordStart, bitOffset, p.modulo, pic.rp, X, pic.height-Y-h, w, h)
END CopyPattern;
PROCEDURE CopyPatternC*(pic:Picture; f: Frame; col: INTEGER; pat: Pattern; X, Y, mode: INTEGER);
	As CopyPattern, but clips the pattern against the frame boundary.
	dx, sx, dy, sy, w, h: INTEGER; p: Amiga.PatternInfoPtr;
	PROCEDURE copyPattern(pic:Picture; col: INTEGER; pat: Pattern; X, Y, dx, dy, w, h, mode: INTEGER);
		Routine used by CopyPattern and CopyPatternC. It will copy a pattern into the designated destination
		area. This routines is able to extract an arbitrary rectangular region from the origin pattern.
		p: Amiga.PatternInfoPtr;
		wordStart, bitIn:LONGINT;
		bitOffset:INTEGER;
	BEGIN
		p := SYSTEM.VAL( Amiga.PatternInfoPtr, pat);
		w := p.w+w; h := p.h+h;
		IF (w > 0) & (h > 0) THEN
			SetDrawMode(pic, col, mode);
			bitIn:=dx+p.offset;
			wordStart:=p.data+dy*p.modulo+bitIn DIV 8;
			bitOffset:=SHORT(bitIn MOD 8);
			IF ODD(wordStart) THEN
				DEC(wordStart);
				INC(bitOffset,8)
			END;
			G.BltTemplate(wordStart, bitOffset, p.modulo, pic.rp, X, pic.height-Y-h, w, h)
		END
	END copyPattern;
BEGIN
	p := SYSTEM.VAL(Amiga.PatternInfoPtr, pat);
	dx := f.X-X; sx := 0; sy := 0; w := p.w; h := p.h;
	IF dx > 0 THEN sx := dx; X := f.X; DEC(w, dx) END;
	dx := X+w-(f.X+f.W);
	IF dx > 0 THEN DEC(w, dx) END;
	dy := f.Y-Y;
	IF dy > 0 THEN Y := f.Y; DEC(h, dy) END;	(* don't adjust sy offset here. *)
	dy := Y+h-(f.Y+f.H);
	IF dy > 0 THEN sy := dy; DEC(h, dy) END;	(* adjust sy offset here, because of Amiga display model *)
	copyPattern(pic, col, pat, X, Y, sx, sy, w-p.w, h-p.h, mode)
END CopyPatternC;
PROCEDURE Dot*(pic:Picture; col: INTEGER; X, Y, mode: INTEGER);
	Change a single pixel.
BEGIN
	SetDrawMode(pic, col, mode);
	G.WritePixel(pic.rp, X, pic.height-Y-1)
END Dot;
PROCEDURE DotC*(pic:Picture; f: Frame; col: INTEGER; X, Y, mode: INTEGER);
 	As Dot, but the the pixel is only written, if contained within the frame boundary.
BEGIN
	IF (X >= f.X) & (X < f.X+f.W) & (Y >= f.Y) & (Y < f.Y+f.H) THEN Dot(pic, col, X, Y, mode) END
END DotC;
PROCEDURE Get*(P: Picture; X, Y: INTEGER): INTEGER;
	Returns color of pixel at pos (X,Y)
	col:INTEGER;
BEGIN
	IF (X<0) OR (X>=P.width) OR (Y<0) OR (Y>=P.height) THEN RETURN black END ;
	IF P.oldMode=invert THEN
		P.oldMode:=replace;
		G.SetWriteMask(P.rp, depthMask);
		G.SetDrMd( P.rp, replace)
	END;
	col:=G.ReadPixel(P.rp,X,P.height-Y-1);
	RETURN col-Amiga.ColorOffset
END Get;
PROCEDURE Copy*(sP, dP: Picture; xs, ys, ws, hs, xd, yd, wd, hd, mode: INTEGER);
	Used to produce a scaled copy of a Picture
	VAR hx, hy, wd2, ws2: LONGINT; dx, dy, xso, xdo: INTEGER;
BEGIN
	dy:=yd + hd;  dx:=xd + wd; xso:=xs; xdo:=xd; wd2:=2*wd; ws2:=2*ws;
	hy:=2*hs - hd;
	WHILE yd < dy DO
		hx:=2*ws - wd; xd:=xdo; xs:=xso;
		WHILE xd < dx DO
			Dot(dP, Get(sP, xs, ys), xd, yd, mode);
			WHILE hx > 0 DO INC(xs); DEC(hx, wd2) END;
			INC(xd); INC(hx, ws2)
		END ;
		WHILE hy > 0 DO INC(ys); hy:=hy - 2*hd END;
		INC(yd); hy:=hy + 2*hs
END Copy;
PROCEDURE ReplConst*(pic: Picture; col, X, Y, W, H, mode: INTEGER);
	Generate a rectangle with the specified color and paint mode.
BEGIN
	IF (W <= 0) OR (H <= 0) THEN RETURN END;
	SetDrawMode(pic, col, mode);
	G.RectFill(pic.rp, X, pic.height-Y-H, X+W-1, pic.height-Y-1)
END ReplConst;
PROCEDURE ReplConstC*(pic: Picture; f: Frame; col: INTEGER; X, Y, W, H, mode: INTEGER);
	As ReplConst, but the rectangle is clipped against the frame boundary.
		dx, dy: INTEGER;
BEGIN
	IF (W <= 0) OR (H <= 0) THEN RETURN END;
	dx := f.X-X;
	IF dx > 0 THEN X := f.X; DEC(W, dx) END;
	dx := X+W-(f.X+f.W);
	IF dx > 0 THEN DEC(W, dx) END;
	dy := f.Y-Y;
	IF dy > 0 THEN Y := f.Y; DEC(H, dy) END;
	dy := Y+H-(f.Y+f.H);
	IF dy > 0 THEN DEC(H, dy) END;
	IF (W >0) & (H > 0) THEN ReplConst(pic,col, X, Y, W, H, mode) END
END ReplConstC;
PROCEDURE ReplPattern*(pic: Picture; col: INTEGER; pat: Pattern; X, Y, W, H, mode: INTEGER);
	Fill the specified area with the pattern.
	x, y, w, h, X1, Y1: INTEGER; p: Amiga.PatternInfoPtr;
	wordStart:LONGINT;
	bitOffset:INTEGER;
BEGIN
	SetDrawMode(pic, col, mode);
	p := SYSTEM.VAL(Amiga.PatternInfoPtr, pat);
	X1 := X+W; Y1 := Y+H; y := Y;
	WHILE y < Y1 DO
		IF y+p.h > Y1 THEN h := Y1-y ELSE h := p.h END;
		x := X;
		WHILE x < X1 DO
			IF x+p.w > X1 THEN w := X1-x ELSE w := p.w END;
			(*AdjustPointer(p.data+(p.h-h)*p.modulo,p.offset,wordStart,bitOffset);*)
			wordStart:=p.data+(p.h-h)*p.modulo+p.offset DIV 8;
			bitOffset:=SHORT(p.offset MOD 8);
			IF ODD(wordStart) THEN
				DEC(wordStart);
				INC(bitOffset,8)
			END;
			G.BltTemplate(wordStart, bitOffset, p.modulo, pic.rp, x, pic.height-y-h, w, h);
			x := x+p.w
		END;
		y := y+p.h
END ReplPattern;
PROCEDURE Min(x, y: INTEGER): INTEGER;
BEGIN IF x < y THEN RETURN x ELSE RETURN y END
END Min;
PROCEDURE Max(x, y: INTEGER): INTEGER;
BEGIN IF x > y THEN RETURN x ELSE RETURN y END
END Max;
PROCEDURE ReplPatternC*(pic:Picture; f: Frame; col: INTEGER; pat: Pattern; X, Y, W, H, X0, Y0, mode: INTEGER);
(* Replicates a pattern pat within the block (X, Y, W, H), clipped against F. The pattern origin is X0, Y0; i.e. for each
	completely visible occurrence of the pattern pat the following holds: ((x - X0) MOD w = 0) & ((y-Y0) MOD h = 0)
	where (x, y) denotes the left and bottom corner, and (w, h) the size of the pattern. *)
	rectangle: G.Rectangle; region, oldRegion: G.RegionPtr; p: Amiga.PatternInfoPtr;
	dx, dy: INTEGER;
BEGIN
	IF (W <= 0) OR (H <= 0) THEN RETURN END;
	region := G.NewRegion();
	rectangle.minX := Max(f.X, X); rectangle.maxX := Min(f.X+f.W-1, X+W-1);
	rectangle.minY := Max(pic.height-f.Y-f.H, pic.height-Y-H);
	rectangle.maxY := Min(pic.height-f.Y-1, pic.height-Y-1);
	IF G.OrRectRegion(region, SYSTEM.ADR(rectangle)) THEN
		p := SYSTEM.VAL(Amiga.PatternInfoPtr, pat);
		dx := (X-X0) MOD p.w; dy := (Y-Y0) MOD p.h;
		oldRegion := L.InstallClipRegion(pic.layer, region);
		ReplPattern(pic, col, pat, X-dx, Y-dy, W+dx, H+dy, mode);
		region := L.InstallClipRegion(pic.layer, oldRegion);
		G.DisposeRegion(region)
END ReplPatternC;
PROCEDURE Update*(P: Picture; X, Y , W, H: INTEGER);
BEGIN
	IF P.notify # NIL THEN P.notify(P, X, Y, W, H) END
END Update;
PROCEDURE DisplayBlock*(P: Picture; X, Y, W, H, DX, DY, mode: INTEGER);
	I assume, this copies the picture to the screen.
BEGIN
	IF defaultPicture=NIL THEN
		HALT(54)
	ELSE
		CopyBlock(P,defaultPicture,X,Y,W,H,DX,DY,mode)
END DisplayBlock;
PROCEDURE ReadInt(VAR R: Files.Rider; VAR i: INTEGER);
VAR hi: SHORTINT; lo: CHAR; li: LONGINT;
BEGIN
	Files.Read(R, lo); Files.Read(R, hi); li:=ORD(lo) + 256*hi; i:=SHORT(li)
END ReadInt;
PROCEDURE WriteInt(VAR R: Files.Rider; i: INTEGER);
BEGIN
	Files.Write(R, CHR(i MOD 256)); Files.Write(R, CHR(i DIV 256 MOD 256))
END WriteInt;
PROCEDURE ReadPal(VAR R: Files.Rider; P: Picture; nofcol: LONGINT);
	col:LONGINT;
BEGIN
	FOR col:=0 TO nofcol-1 DO
		Files.Read(R, P.pal[col].r); Files.Read(R, P.pal[col].g); Files.Read(R, P.pal[col].b)
END ReadPal;
PROCEDURE WritePal(VAR R: Files.Rider; P: Picture; nofcol: LONGINT);
VAR col: LONGINT;
BEGIN
	FOR col:=0 TO nofcol-1 DO
		Files.Write(R, P.pal[col].r); Files.Write(R, P.pal[col].g); Files.Write(R, P.pal[col].b)
END WritePal;
PROCEDURE Define(P: Picture; width, height, depth: INTEGER);	(* set width, height, depth, next, pixmap *)
BEGIN
	IF (P.width # width) OR (P.height # height) OR (P.depth # depth) OR (P.layer=0) THEN
		IF (width=0) OR (height=0) OR (depth=0) THEN HALT(50) END ;
		IF P.layer # 0 THEN FreeLayer(P) ELSE Kernel.RegisterObject(P, Finalize) END ;
		P.width:=width; P.height:=height; P.depth:=depth;
		InitLayer(P);
		IF P.layer=0 THEN HALT(40) END;
		P.oldCol:=-1;
		P.oldMode:=-1
END Define;
PROCEDURE ReadData(VAR R: Files.Rider; P: Picture; exp, map, rv: BOOLEAN);
	Load run length encoded picture.
	ch,ch1:CHAR;
	k:INTEGER;
	x,y,yoff:INTEGER;
	width, height, depth: INTEGER;
	m:ARRAY 256 OF CHAR;
	r:G.RastPortPtr;
	rptr:RastPortPtr;
	bptr:BitMapPtr;
	bpr: LONGINT;
	planes: ARRAY 8 OF LONGINT;
	(* faster Version of Dot, only for ReadData *)
	PROCEDURE NDot(col, X, Y: INTEGER);
	BEGIN
		IF P.oldCol # col THEN P.oldCol := col; G.SetAPen(r, col+Amiga.ColorOffset) END;
		G.WritePixel(r, X, P.height-Y-1)
	END NDot;
	PROCEDURE Unpack(p: LONGINT);
		i: INTEGER;
		pixel: INTEGER;
	BEGIN
		i:=8;
		REPEAT
			IF ODD(p) THEN pixel:=white ELSE pixel:=black END;
			NDot(pixel,x,yoff-y-1); INC(x); p:=ASH(p,-1); DEC(i)
		UNTIL (i=0) OR (x=width)
	END Unpack;
	(* new unpack writes data direct to the planes *)
	PROCEDURE Unpack(p: INTEGER);
		VAR
			offset, count: LONGINT;
			b: SYSTEM.BYTE;
	BEGIN
		b:=swap[p];
		offset:=y*bpr+ASH(x,-3);
		IF Amiga.OberonDepth<5 THEN
			FOR count:=0 TO Amiga.OberonDepth-1 DO
				SYSTEM.PUT(planes[count]+offset, b)
			END
		ELSE
			FOR count:=0 TO 3 DO
				SYSTEM.PUT(planes[count]+offset, b)
			END;
			FOR count:=4 TO Amiga.OberonDepth-1 DO
				SYSTEM.PUT(planes[count]+offset, 0X)
			END
		END;
		INC(x, 8)
	END Unpack;
BEGIN
	r:=P.rp; Dot(P, 0, 0, 0, replace); (* needed for new Dot *)
	rptr:=SYSTEM.VAL(RastPortPtr, r);
	depth:=P.depth;
	height:=P.height;
	width:=P.width;
	yoff:=P.height-1;
	IF depth=1 THEN (* install everythink for new Unpack *)
		rptr:=SYSTEM.VAL(RastPortPtr, r);
		bptr:=SYSTEM.VAL(BitMapPtr, rptr.bitMap);
		bpr:=bptr.bytesPerRow;
		FOR k:=0 TO Amiga.OberonDepth DO
			planes[k]:=SYSTEM.VAL(LONGINT, bptr.planes[k])
		END
	END;
	IF map THEN
		(*WHILE k < 256 DO m[k] := CHR((k MOD 2)*15); INC(k) END ;
		m[12] := CHR(15); m[13] := CHR(0); m[14] := CHR(15)*)
		x:=SHORT(ASH(1,depth));m[0]:=0X;
		FOR k:=1 TO 255 DO
			m[k]:=CHR(k MOD x);
			IF m[k]=0X THEN m[k]:=0FX END
		END
	END;
	y:=0;
	FOR y:=0 TO height-1 DO
		x:=0;
		WHILE x<width  DO
			Files.Read(R,ch);
			k:=ORD(ch);
			IF k<128 THEN
				REPEAT
					Files.Read(R,ch);
					IF exp THEN
						ch1:=CHR(ORD(ch) MOD 16);
						ch:=CHR(ORD(ch) DIV 16);
						IF map THEN
							ch1:=m[ORD(ch1)];
							ch:=m[ORD(ch)]
						END;
						NDot(ORD(ch1),x,yoff-y);
						INC(x)
					ELSIF map THEN
						ch:=m[ORD(ch)]
					ELSIF rv THEN
						ch:=CHR(rev[ORD(ch) DIV 16]+rev[ORD(ch) MOD 16]*16)
					END;
					IF x<width THEN
						IF (depth=1) & ~map THEN
							Unpack(ORD(ch))
						ELSE
							NDot(ORD(ch),x,yoff-y);
							INC(x)
						END
					END ;
					DEC(k)
				UNTIL k<0
			ELSE
				k:=257-k;
				Files.Read(R, ch);
				IF exp THEN
					ch1:=CHR(ORD(ch) MOD 16);
					ch:=CHR(ORD(ch) DIV 16);
					IF map THEN
						ch1:=m[ORD(ch1)];
						ch:=m[ORD(ch)]
					END
				ELSIF map THEN
					ch:=m[ORD(ch)]
				ELSIF rv THEN
					ch:=CHR(rev[ORD(ch) DIV 16]+rev[ORD(ch) MOD 16]*16)
				END ;
				REPEAT
					IF exp THEN
						NDot(ORD(ch1),x,yoff-y);
						INC(x)
					END;
					IF x < width THEN
						IF (depth=1) & ~map THEN
							Unpack(ORD(ch))
						ELSE
							NDot(ORD(ch),x,yoff-y);
							INC(x)
						END
					END;
					DEC(k)
				UNTIL k<1
			END
		END
	END;
	G.SetWriteMask(P.rp, 0)
END ReadData;
PROCEDURE Load*(P: Picture; F: Files.File; pos: LONGINT; VAR len: LONGINT);
	Load a pictures which was identified as starting with a PictFileId.
	expand,map:BOOLEAN;
	R:Files.Rider;
	width,height,depth:INTEGER;
BEGIN
	Files.Set(R,F,pos); ReadInt(R,width); ReadInt(R,height); ReadInt(R,depth);
	ReadPal(R,P,ASH(1,depth)); (* RGB-Werte der Originalfarben laden *)
	expand:=FALSE;
	map:=FALSE;
	IF depth=4 THEN (* Ceres color picture *)
		expand:=TRUE;
		map:=Amiga.OberonDepth#4;
		depth:=Amiga.OberonDepth
	ELSIF depth>Amiga.OberonDepth THEN
		map:=TRUE;
		depth:=Amiga.OberonDepth
	END ;
	(* IF (depth#Amiga.Depth) & (depth#1) THEN HALT(43) END; *)
	Define(P,width,height,depth);
	ReadData(R,P,expand,map,FALSE);
	len:=Files.Pos(R)-pos
END Load;
PROCEDURE Store*(P: Picture; F: Files.File; pos: LONGINT; VAR len: LONGINT);
	stores picture to run length encoded file F   (including tag)
	a, b, x, y, width, height, depth, oridepth: INTEGER;
	j: LONGINT;
	h: CHAR;
	buf: ARRAY 129 OF CHAR;
	R: Files.Rider;
	PROCEDURE Pack(): CHAR;
		VAR i, j, p: INTEGER;
	BEGIN
		i:=8; j:=1; p:=0;
		REPEAT
			IF Get(P, x, P.height-y-1)#black THEN INC(p, j) END;
			INC(x); j:=j*2; DEC(i)
		UNTIL (i=0) OR (x=width);
		RETURN CHR(p)
	END Pack;
	(* store pictures with 4 planes in Ceres 4 colors-format *)
	PROCEDURE PackColor(): CHAR;
		VAR ch, ch1: INTEGER;
	BEGIN
		ch:=Get(P, x, P.height-y-1)-Amiga.ColorOffset; INC(x);
		ch1:=Get(P, x, P.height-y-1)-Amiga.ColorOffset; INC(x);
		RETURN CHR(ch+ch1*16)
	END PackColor;
BEGIN
	width:=P.width; height:=P.height; oridepth:=P.depth;
	(* only store as 1, 4 or 8 Plane Pict *)
	depth:=oridepth;
	IF (oridepth=2) OR (oridepth=3) THEN depth:=4 END;
	IF (oridepth>4) & (oridepth<7) THEN depth:=8 END;
	Files.Set(R, F, pos); WriteInt(R, PictFileId);
	WriteInt(R, width); WriteInt(R, height); WriteInt(R, depth);
	WritePal(R, P, ASH(1, depth));
	(* fill Colortabel with 0 *)
	IF depth#oridepth THEN
		FOR j:=1 TO (ASH(1, depth)-ASH(1, oridepth))*3 DO
			Files.Write(R, CHR(0))
		END
	END;
	y:=0;
	WHILE height > 0 DO x:=0; a:=0;
		j:=1; buf[0]:=0X;
		IF depth=1 THEN h:=Pack()
		ELSIF depth=4 THEN h:=PackColor()
		ELSE h:=CHR(Get(P, x, P.height-y-1)); INC(x)
		END ;
		b:=1; buf[j]:=h;
		WHILE x < width DO
			IF depth=1 THEN h:=Pack()
			ELSIF depth=4 THEN h:=PackColor()
			ELSE h:=CHR(Get(P, x, P.height-y-1)); INC(x)
			END;
			IF ((b - a) < 127) & ((buf[0]=0X) OR ((h=buf[j]) & (j=1)) OR ((h # buf[j]) & (j  > 1))) THEN (* same run *)
				IF h # buf[j] THEN INC(SYSTEM.VAL(SHORTINT, buf[0])); INC(j); buf[j]:=h
				ELSE DEC(SYSTEM.VAL(SHORTINT, buf[0])) END
			ELSE (* new run *)
				IF (buf[j]=h) & (b - a # 127) THEN DEC(SYSTEM.VAL(SHORTINT, buf[0])); Files.WriteBytes(R, buf, j); buf[0]:=0FFX
				ELSE Files.WriteBytes(R, buf, j + 1); buf[0]:=0X END ;
				j:=1; buf[j]:=h; a:=b
			END ;
			INC(b)
		END ;
		Files.WriteBytes(R, buf, j + 1);
		DEC(height); INC(y)
	END ;
	len:=Files.Pos(R) - pos
END Store;
PROCEDURE Create*(P: Picture; width, height, depth: INTEGER);
	Create a picture with the requested size. The main work is done
	in Define. This only clears the picture area and the color
	palette.
	col: INTEGER;
BEGIN
	Define(P, width, height, depth);
	ReplConst(P, black, 0, 0, P.width, P.height, replace);
	FOR col:=0 TO 255 DO P.pal[col].r:=0X; P.pal[col].g:=0X; P.pal[col].b:=0X END
END Create;
PROCEDURE Open*(P: Picture; name: ARRAY OF CHAR);
	Load a file into a picture.
	F:Files.File;
	R:Files.Rider;
	len: LONGINT;
	x, d: INTEGER;
	dname: ARRAY 64 OF CHAR;
BEGIN
	F:=Files.Old(name);
	IF F#NIL THEN
		Files.Set(R,F,0);
		x:=0;
		ReadInt(R,x);
		IF x=0 THEN (* MacPaint format *)
			Define(P,576,720,1);
			Files.Set(R,F,Files.Pos(R)+510);
			ReadData(R,P,FALSE,FALSE,TRUE)
		ELSIF x=PictFileId THEN
			Load(P,F,2,len)
		ELSIF x=07F7H THEN (* Skipping System3 File-Header *)
			Files.ReadString(R, dname); Files.ReadInt(R, d); Files.ReadInt(R, d); Files.ReadInt(R, d); Files.ReadInt(R, d);
			Files.ReadInt(R, x);
			IF x=PictFileId THEN
				Load(P, F, Files.Pos(R), len)
			ELSE
				O.Str("System3-File, Unknown format");O.Ln
			END
		ELSE
			O.Str("Unknown format");O.Ln
		END
	ELSE
		O.Str("Pictures.Open: "); O.Str(name); O.Str(" failed"); O.Ln;
		Create(P,Amiga.Width*5 DIV 8 -20,Amiga.Height-80,Amiga.OberonDepth)
END Open;
PROCEDURE SetColor*(P:Picture; col,red,green,blue:INTEGER);
	Change the RGB values of a palette entry.
BEGIN
	IF (col<nofCols) & (col>=0) THEN
		P.pal[col].r:=CHR(red); P.pal[col].g:=CHR(green); P.pal[col].b:=CHR(blue)
END SetColor;
PROCEDURE GetColor*(P: Picture; col: INTEGER; VAR red, green, blue: INTEGER);
	Retrieve the RGB values of a palette entry.
BEGIN
	IF (col<nofCols) & (col>=0) THEN
		red:=ORD(P.pal[col].r); green:=ORD(P.pal[col].g); blue:=ORD(P.pal[col].b)
END GetColor;
PROCEDURE NewPattern*(VAR image: ARRAY OF SET; w, h: INTEGER): Pattern;
(* Allocates a new pattern with width w and height h. The i-th pattern line from bottom (increasing y-value)
	corresponds to the image entries (i+1)*lineLen .. (i+2)*lineLen-1, where lineLen = (w+31) DIV 32.
	The set elements describe the pixels from left to right (increasing x-value). *)
CONST header=4;
		ch: CHAR; src, dest: LONGINT; byte, bytesPerRow, i, size: LONGINT;
		pattern: Amiga.PatternInfoPtr; patNode: PatternNode;
BEGIN
	Amiga.Assert((0<w) & (w<=32) & (0<h),"Illegal pattern size");
	NEW(pattern); pattern.w := SHORT(w); pattern.h := SHORT(h); pattern.modulo := 2*((w+15) DIV 16);
	NEW(patNode); patNode.next := patternRoot; patternRoot := patNode;
	patNode.p := pattern;	(* to insert pattern into global list for GC *)
	size := pattern.modulo*h;
	IF Amiga.ChipMemPool#0 THEN
		pattern.data:=E.AllocPooled(Amiga.ChipMemPool, size)
	ELSE
		pattern.data := E.AllocMem(size, {E.memChip})
	END;
	pattern.offset:=0;
	bytesPerRow := (w + 7) DIV 8;
	src := SYSTEM.ADR(image)+header+3; dest := pattern.data+pattern.modulo*(h-1);
	FOR i := 0 TO h-1 DO
		FOR byte := 1 TO bytesPerRow DO
			SYSTEM.GET(src, ch); SYSTEM.PUT(dest, Amiga.SwapBits[ORD(ch)]);
			DEC(src); INC(dest)
		END;
		DEC(dest, bytesPerRow+pattern.modulo);
		INC(src, bytesPerRow+4)
	END;
	RETURN SYSTEM.VAL(Pattern,pattern)
END NewPattern;
PROCEDURE Line*(pic:Picture; f:Frame; col, X0, Y0, X1, Y1, mode: INTEGER);
(* Draws a line from (X0, Y0) to (X1, Y1) inclusive, clipped against F.  For all line points (x, y) the following holds
always: (min(X0, X1) <= x) & (x <= max(X0, X1) & (min(Y0, Y0) <= y) & (y <= max(Y0, Y1). *)
	rectangle: G.Rectangle;
	region,oldRegion: G.RegionPtr;
BEGIN
	SetDrawMode(pic, col, mode);
	region := G.NewRegion();
	rectangle.minX := f.X; rectangle.maxX := f.X+f.W-1;
	rectangle.minY := pic.height-f.Y-f.H; rectangle.maxY := rectangle.minY+f.H-1;
	IF G.OrRectRegion(region, SYSTEM.ADR(rectangle)) THEN
		oldRegion := L.InstallClipRegion(pic.layer, region);
		G.Move(pic.rp,X0,pic.height-Y0-1);
		G.Draw(pic.rp,X1,pic.height-Y1-1);
		region := L.InstallClipRegion(pic.layer, oldRegion);
		G.DisposeRegion(region)
END Line;
PROCEDURE Ellipse*(pic:Picture; f:Frame; col, X, Y, A, B, mode: INTEGER);
(* Draws an ellipse with center (X, Y) and radii A and B, clipped against F. For all ellipse points (x, y)  the following holds
	always: (X-A <= x) & (x < X+A) & (Y-B <= y) & (y < Y+B). When A = B the resulting ellipse has the same shape
	as the corresponding circle with R = A. *)
	rectangle: G.Rectangle;
	region,oldRegion: G.RegionPtr;
BEGIN
	SetDrawMode(pic, col, mode);
	region := G.NewRegion();
	rectangle.minX := f.X; rectangle.maxX := f.X+f.W-1;
	rectangle.minY := pic.height-f.Y-f.H; rectangle.maxY := rectangle.minY+f.H-1;
	IF G.OrRectRegion(region, SYSTEM.ADR(rectangle)) THEN
		oldRegion := L.InstallClipRegion(pic.layer, region);
		G.DrawEllipse(pic.rp,X,pic.height-Y-1,A,B);
		region :=L.InstallClipRegion(pic.layer, oldRegion);
		G.DisposeRegion(region)
END Ellipse;
PROCEDURE Circle*(pic:Picture; f:Frame; col, X, Y, R, mode: INTEGER);
(* Draws a circle with center (X, Y) and radius R, clipped against F. For all circle points (x, y)  the following holds always:
	(X-R <= x) & (x < X+R) & (Y-R <= y) & (y < Y+R). *)
BEGIN
	Ellipse(pic,f,col,X,Y,R,R,mode)
END Circle;
PROCEDURE AmigaText*(P:Picture; font:G.TextFontPtr; VAR text: ARRAY OF CHAR; count, x, y, col, mode: INTEGER);
	Print text with Amiga font
BEGIN
	SetDrawMode(P, col, mode);
	G.Move(P.rp, x, P.height-y-1);
	G.SetFont(P.rp, font);
	G.Text(P.rp, text, count)
END AmigaText;
PROCEDURE Init;
	im: ARRAY 17 OF SET;
	k: INTEGER;
BEGIN
	defaultPicture:=NIL;
	nofCols:=SHORT(ASH(1, Amiga.OberonDepth));
	depthMask:=nofCols-1;
	DrMode[replace]:=G.jam2;  DrMode[paint]:=G.jam1;  DrMode[invert]:=G.complement;		(*<<OJ*)
	MinTerm[replace]:=0C0X;	  (* dest := BC + B~C *)
	MinTerm[paint]:=0E0X;		 (* dest := BC + ~BC + B~C *)
	MinTerm[invert]:=060X;		(* dest := B~C + ~BC *)
	patternRoot:=NIL;
	rev[0]:=0; rev[1]:=8; rev[2]:=4; rev[3]:=12;
	rev[4]:=2; rev[5]:=10; rev[6]:=6; rev[7]:=14;
	rev[8]:=1; rev[9]:=9; rev[10]:=5; rev[11]:=13;
	rev[12]:=3; rev[13]:=11; rev[14]:=7; rev[15]:=15;
	im[1]:={};
	im[2]:={1..7,9..15}; im[3]:=im[2]; im[4]:=im[2]; im[5]:=im[2];
	im[6]:=im[2]; im[7]:=im[2]; im[8]:=im[2]; im[9]:=im[1];
	im[10]:=im[2]; im[11]:=im[2]; im[12]:=im[2]; im[13]:=im[2];
	im[14]:=im[2]; im[15]:=im[2]; im[16]:=im[2];
	dots:=NewPattern(im, 16, 16)
END Init;
BEGIN
	Init
END Pictures.